home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / ModeComposer-Shan.st < prev    next >
Text File  |  1993-07-24  |  19KB  |  636 lines

  1. OpaqueController1 subclass: #MidMenuAndMoveController
  2.     instanceVariableNames: ''
  3.     classVariableNames: 'MidMenuAndMoveControllerERD '
  4.     poolDictionaries: ''
  5.     category: 'ModeComposer-Shan'!
  6.  
  7. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  8.  
  9. MidMenuAndMoveController class
  10.     instanceVariableNames: ''!
  11.  
  12.  
  13. !MidMenuAndMoveController class methodsFor: 'initialize'!
  14.  
  15. ERDinit
  16.  
  17.     MidMenuAndMoveControllerERD _ super eventResponsesDict deepCopy.
  18.     MidMenuAndMoveControllerERD at: #middleButtonDown put: #expandMiddleMenu.
  19.     MidMenuAndMoveControllerERD at: #enterMode put: #highlight.
  20.     MidMenuAndMoveControllerERD at: #leftButtonDown put: #moveImage.
  21.     MidMenuAndMoveControllerERD at: #leaveMode put: #deHighlight.! !
  22.  
  23. !MidMenuAndMoveController class methodsFor: 'access'!
  24.  
  25. eventResponsesDict
  26.     ^MidMenuAndMoveControllerERD! !
  27.  
  28. SemanticObject subclass: #LibraryObject
  29.     instanceVariableNames: 'prototype label '
  30.     classVariableNames: 'LibraryObjectMiddleButtonMenu '
  31.     poolDictionaries: ''
  32.     category: 'ModeComposer-Shan'!
  33.  
  34.  
  35. !LibraryObject methodsFor: 'access'!
  36.  
  37. name
  38.     "Shan August 26, 1989"
  39.  
  40.     ^label string!
  41.  
  42. name: aString 
  43.     "Shan August 26, 1989"
  44.  
  45.     label text: aString!
  46.  
  47. prototype
  48.     "Shan July 31, 1989"
  49.  
  50.     ^prototype! !
  51.  
  52. !LibraryObject methodsFor: 'private'!
  53.  
  54. prototype: aSemObj name: aString 
  55.     "Automatically recude the size of icon without asking the user. Shan 
  56.     November 17, 1989"
  57.  
  58.     | f scale ext |
  59.     prototype _ aSemObj.
  60.     label _ TextLabel text: aString.
  61.     f _ prototype mode image.
  62.     ext _ f extent.
  63.     ext x > 100 | (ext y > 75)
  64.         ifTrue: 
  65.             ["Better reduce it"
  66.             scale _ ext / (100 @ 75).
  67.             scale _ (scale x max: scale y) asPoint.    "Reduce aliasing."
  68.             "scale _ scale rounded + 0.5. 
  69.             f _ f shrinkBy: scale."
  70.             f _ prototype mode imageSize: (ext / scale) rounded].
  71.     ModeGrouper parent: mode centerVerticalChildren: (OrderedCollection with: (FixedImageMode new imageForm: f)
  72.             with: label mode)! !
  73.  
  74. !LibraryObject methodsFor: 'duplication'!
  75.  
  76. duplicateProtoMode
  77.     "Shan August 3, 1989"
  78.  
  79.     | newMode oops cores |
  80.     oops _ Smalltalk oopsLeft.
  81.     cores _ Smalltalk coreLeft.
  82.     newMode _ prototype mode duplicate.
  83.     oops _ oops - Smalltalk oopsLeft.
  84.     cores _ cores - Smalltalk coreLeft.
  85.     oops > 1000 ifTrue: [self error: 'Needs a lot of oops'].
  86.     oops > 100000 ifTrue: [self error: 'Needs a lot of memory'].
  87.     ^newMode!
  88.  
  89. duplicatePrototype
  90.     "Shan September 5, 1989"
  91.  
  92.     "^self duplicateProtoMode semanticObject"
  93.     ^prototype duplicate! !
  94.  
  95. !LibraryObject methodsFor: 'MMS-initializations'!
  96.  
  97. defaultMMSControllerClass
  98.     "Shan August 25, 1989"
  99.  
  100.     ^MidMenuAndMoveController!
  101.  
  102. defaultModeClass
  103.     "Shan August 24, 1989"
  104.  
  105.     ^ModeGroup! !
  106.  
  107. !LibraryObject methodsFor: 'middleMenu support'!
  108.  
  109. bosFileOut
  110.     "File the prototype to a file. Still need to fileOut the newly created 
  111.     classes (if any) by hand. Shan November 17, 1989"
  112.  
  113.     | aFileName |
  114.     self eventQueue disable.
  115.     aFileName := FillInTheBlank request: 'File name for saving the prototype ' initialAnswer: self name , '.it'.
  116.     self eventQueue enable.
  117.     aFileName = '' ifTrue: [^nil].
  118.     aFileName asFilename exists
  119.         ifTrue: 
  120.             [self eventQueue disable.
  121.             (self confirm: 'File already exists.  Proceed to overwrite?')
  122.                 ifFalse: [^nil].
  123.             self eventQueue enable].
  124.     Cursor write showWhile: [BinaryStorage put: self prototype onFileNamed: aFileName]!
  125.  
  126. duplicateAndPlace
  127.     "Make a deep copy of the prototype and place it in the workSpace.    
  128.         Shan August 1, 1989"
  129.  
  130.     | newProto newProtoMode newPos containingMode rootMode |
  131.     Cursor wait
  132.         showWhile: 
  133.             [newProto _ self duplicatePrototype.
  134.             rootMode _ mode topMode.
  135.             "Do not directly paste the mode because there could be more  
  136.              mode to paste.  For example, Window has two   
  137.             modes--aWindowMode and a shrunkenWindow mode."
  138.             newProto attachModeTo: rootMode absAt:  self eventQueue mousePoint - (newProto mode displayBox extent / 2).
  139.             newProtoMode _ newProto mode.
  140.             newProtoMode display].
  141.     newPos _ newProtoMode controller moveImageFB.
  142.     newPos notNil
  143.         ifTrue: 
  144.             ["newDispBox _ newProtoMode unclippedDisplayBox moveTo: newPos.
  145.             containingMode _ rootMode firstModeCovering: newDispBox 
  146.             suchThat: [:theMode | (theMode isKindOf: LineMode) not]."
  147.             "This way I can paste a bigger mode into a smaller mode.  
  148.             August 16, 1989"
  149.             containingMode _ rootMode firstModeAt: self eventQueue mousePoint suchThat: [:theMode | (theMode isKindOf: LineMode) not].
  150.             newProto attachModeTo: containingMode absAt:  newPos.             "containingMode addSubMode: newProtoMode absAt: newPos.  Shan September 11, 1989"
  151.             newProtoMode display.
  152.             newProtoMode edit]!
  153.  
  154. edit
  155.     "Shan July 31, 1989"!
  156.  
  157. remove
  158.     "Shan August 27, 1989"
  159.  
  160.     | choice |
  161.     self eventQueue disable.
  162.     choice _ BinaryChoice message: 'Do you really want to remove it?'.
  163.     self eventQueue enable.
  164.     choice ifFalse: [^nil].
  165.     LibrarySpace ITStore removeKey: self name.
  166.     mode erase.
  167.     prototype mode release.
  168.     mode removeFromSuperMode.
  169.     mode release!
  170.  
  171. rename
  172.     "This is a temp fix.  Should be able to click on the text label and 
  173.     change the name eventually.  Shan August 26, 1989"
  174.  
  175.     | name |
  176.     self eventQueue disable.
  177.     name _ FillInTheBlank request: 'Please enter the new name of this library object.'.
  178.     self eventQueue enable.
  179.     name = '' ifTrue: [^nil].
  180.     label displayText: name! !
  181.  
  182. !LibraryObject methodsFor: 'menu access'!
  183.  
  184. middleButtonMenu
  185.     "Shan July 31, 1989"
  186.  
  187.     | logicMenu |
  188.     LibraryObjectMiddleButtonMenu isNil
  189.         ifTrue: 
  190.             [logicMenu _ MMSMenu new.
  191.             logicMenu append: (MenuCell selector: #duplicateAndPlace text: 'Duplicate').
  192.             logicMenu append: (MenuCell selector: #edit text: 'Edit').
  193.             logicMenu append: (MenuCell selector: #rename text: 'Rename').
  194.             logicMenu append: (MenuCell selector: #remove text: 'Remove').
  195.             logicMenu append: (MenuCell selector: #bosFileOut text: 'Store to file').
  196.             LibraryObjectMiddleButtonMenu _ MMSPopUpMenu createInterfaceFor: logicMenu].
  197.     ^LibraryObjectMiddleButtonMenu! !
  198. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  199.  
  200. LibraryObject class
  201.     instanceVariableNames: ''!
  202.  
  203.  
  204. !LibraryObject class methodsFor: 'instance creation'!
  205.  
  206. prototype: aSemObj 
  207.     "Shan July 31, 1989"
  208.  
  209.     ^self prototype: aSemObj name: aSemObj class name!
  210.  
  211. prototype: aSemObj name: aString
  212.     "Shan July 31, 1989"
  213.  
  214.     ^self new prototype: aSemObj name: aString! !
  215.  
  216. LibraryObject subclass: #FixedImageLibObj
  217.     instanceVariableNames: ''
  218.     classVariableNames: 'FormSizeMenu '
  219.     poolDictionaries: ''
  220.     category: 'ModeComposer-Shan'!
  221.  
  222.  
  223. !FixedImageLibObj methodsFor: 'duplication'!
  224.  
  225. duplicatePrototype
  226.     "Let the user specify the size of the form.  Shan September 5, 1989"
  227.  
  228.     Cursor normal showWhile: [self formSizeMenu startUpOnSemanticObject: self].
  229.     ^prototype duplicate! !
  230.  
  231. !FixedImageLibObj methodsFor: 'menu support'!
  232.  
  233. changePrototypeFormTo: aMMSOpaqueForm
  234.     "Shan September 5, 1989"
  235.  
  236.     prototype mode displayObject clear.
  237.     prototype mode displayObject absAdd: aMMSOpaqueForm.
  238.     prototype mode resizeToFitDisplayObject!
  239.  
  240. sameAsLast
  241.     "Do nothing.  Shan September 5, 1989"!
  242.  
  243. sizeByDM
  244.     "Shan September 6, 1989"
  245.  
  246.     | aRect |
  247.     self eventQueue disable.
  248.     aRect _ Rectangle fromUser.
  249.     self eventQueue enable.
  250.     self changePrototypeFormTo: (MMSOpaqueForm figure: ((Form fromDisplay: aRect)
  251.                 border: (0 @ 0 extent: aRect extent)
  252.                 width: 1)
  253.             shape: (Form extent: aRect extent) black)!
  254.  
  255. sizeByText
  256.     "Shan September 6, 1989"
  257.  
  258.     | ext int |
  259.     ext _ 50 @ 50.
  260.     self eventQueue disable.
  261.     int _ FillInTheBlank request: 'Width in points' initialAnswer: '50'.
  262.     ext x: int asNumber.
  263.     int _ FillInTheBlank request: 'Height in points' initialAnswer: '50'.
  264.     ext y: int asNumber.
  265.     self eventQueue enable.
  266.     self changePrototypeFormTo: (MMSOpaqueForm figure: ((Form extent: ext)
  267.                 border: (0 @ 0 extent: ext)
  268.                 width: 1)
  269.             shape: (Form extent: ext) black)!
  270.  
  271. standard
  272.     "Shan September 5, 1989"
  273.  
  274.     prototype mode displayObject clear.
  275.     self changePrototypeFormTo: (MMSOpaqueForm figure: ((Form extent: 50@50)
  276.                 border: (0 @ 0 extent: 50@50)
  277.                 width: 1)
  278.             shape: (Form extent: 50@50) black)! !
  279.  
  280. !FixedImageLibObj methodsFor: 'menu access'!
  281.  
  282. formSizeMenu
  283.     "Shan September 5, 1989"
  284.     | logicMenu |
  285.     FormSizeMenu isNil
  286.         ifTrue: 
  287.             [logicMenu _ MMSMenu new.
  288.             logicMenu append: (MenuCell selector: #sizeByDM text: 'Give size by mouse').
  289.             logicMenu append: (MenuCell selector: #sizeByText text: 'Give size by text').
  290.             logicMenu append: (MenuCell selector: #standard text: 'Standard 50x50').
  291.             logicMenu append: (MenuCell selector: #sameAsLast text: 'Same as last').
  292.             FormSizeMenu _ MMSPopUpMenu createInterfaceFor: logicMenu].
  293.     ^FormSizeMenu! !
  294.  
  295. SemanticObject subclass: #LibrarySpace
  296.     instanceVariableNames: ''
  297.     classVariableNames: 'ITStore LibrarySpaceMiddleButtonMenu '
  298.     poolDictionaries: ''
  299.     category: 'ModeComposer-Shan'!
  300.  
  301.  
  302. !LibrarySpace methodsFor: 'initialize-release'!
  303.  
  304. initialize
  305.     super initialize.
  306.     "Shan September 16, 1989"
  307.     self initITStoreObjs!
  308.  
  309. initITStoreObjs
  310.     "ITStore keeps a collection of user created LibraryObjects.  Every 
  311.     time the mode composer is started.  These objects should be included. 
  312.     Shan September 16, 1989"
  313.  
  314.     LibrarySpace ITStore values do: [:each | each duplicate attachModeTo: mode]! !
  315.  
  316. !LibrarySpace methodsFor: 'promotion'!
  317.  
  318. promote: aSemObj 
  319.     "Include aSemObj into the library for future reuse. Shan August 26, 
  320.     1989"
  321.  
  322.     | name pastePt choice |
  323.     pastePt _ self eventQueue mousePoint - 20.
  324.     self eventQueue disable.
  325.     choice _ BinaryChoice message: 'Do you really want to promote this\ Interaction Technique into the library?' withCRs.
  326.     self eventQueue enable.
  327.     choice ifFalse: [^nil].
  328.     name _ nil.
  329.     [name isNil]
  330.         whileTrue: 
  331.             [self eventQueue disable.
  332.             name _ FillInTheBlank request: 'Please enter the name of this library object.'.
  333.             self eventQueue enable.
  334.             name = '' ifTrue: [^nil].
  335.             (ITStore includesKey: name)
  336.                 ifTrue: 
  337.                     [name _ nil.
  338.                     self notify: 'This name has been used in the library. \ Either choose another name or remove the old one first.' withCRs]].    "Make a LibraryObject to represent it at where the mouse pt."
  339.     self
  340.         promote: aSemObj
  341.         withName: name
  342.         at: pastePt!
  343.  
  344. promote: aSemObj withName: name at: pastePt
  345.     "No question asked.  Shan November 17, 1989"
  346.  
  347.     |  prototype libObj   |
  348.     Cursor wait
  349.         showWhile: 
  350.             [prototype _ aSemObj duplicate.
  351.             "This is not necessary.  The duplicate method should handle it. 
  352.              prototype mode removeFromSuperMode."
  353.             libObj _ LibraryObject prototype: prototype name: name.
  354.             libObj attachModeTo: mode absAt: pastePt.
  355.             "The 'duplicate' is to avoid the libObj being released when the 
  356.             user close the MMSStdSysView.  Shan September 16, 1989"
  357.             ITStore at: libObj name put: libObj duplicate.
  358.             libObj mode display]! !
  359.  
  360. !LibrarySpace methodsFor: 'menu access'!
  361.  
  362. middleButtonMenu
  363.     "Shan November 17, 1989"
  364.  
  365.     | logicMenu |
  366.     LibrarySpaceMiddleButtonMenu isNil
  367.         ifTrue: 
  368.             [logicMenu _ MMSMenu new.
  369.             logicMenu append: (MenuCell selector: #importITObject text: 'Import IT Object').
  370.             LibrarySpaceMiddleButtonMenu _ MMSPopUpMenu createInterfaceFor: logicMenu].
  371.     ^LibrarySpaceMiddleButtonMenu! !
  372.  
  373. !LibrarySpace methodsFor: 'middleMenu support'!
  374.  
  375. importITObject
  376.     "The file is a BOS that stores a prototype. Shan November 17, 1989"
  377.  
  378.     | aFileName tmp aName |
  379.     self eventQueue disable.
  380.     aFileName := FillInTheBlank request: 'Load IT object from file name' initialAnswer: 'filename.it'.
  381.     self eventQueue enable.
  382.     aFileName = '' ifTrue: [^nil].
  383.     Cursor read showWhile: [tmp := BinaryStorage fromFileNamed: aFileName].
  384.     self eventQueue disable.
  385.     aName := FillInTheBlank request: 'Name for this library object' initialAnswer: (aFileName copyUpTo: $.).
  386.     self eventQueue enable.
  387.     self
  388.         promote: tmp
  389.         withName: aName
  390.         at: mode controller event origin! !
  391.  
  392. !LibrarySpace methodsFor: 'MMS-initializations'!
  393.  
  394. defaultMMSControllerClass
  395.     "Shan November 18, 1989"
  396.  
  397.     ^MidMenuController! !
  398. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  399.  
  400. LibrarySpace class
  401.     instanceVariableNames: ''!
  402.  
  403.  
  404. !LibrarySpace class methodsFor: 'demo'!
  405.  
  406. demoScript
  407.     "This is a text script of the demo.  Follow this script to demo the 
  408.     ModeComposer.  Shan September 21, 1989"
  409. "
  410.  
  411. SHOW THE SUN'S PERFMETER.
  412.  
  413. DeskCal
  414. 1. Get a background and paste
  415.     TextLabel (don't change text)
  416.     3 TextButtons (0,1,C)
  417.         Push one button
  418. 2. Ask what this is.
  419.     Give hints
  420.         Change text to 908876512
  421.         Add a 'Sharp' logo
  422. 3. Create ApplObj and connect 0 and
  423.      1 button with it.  Connect it to
  424.      displayArea.
  425. 4. Change ApplObj to include memory
  426. 5. Add C button
  427. 6. Hide connection and promote it.
  428. 7. Put it into a window
  429.  
  430. Self Building
  431. 1. Ctrl-E the close box and show 
  432.     connections
  433. 2. Recursively Show-SemObj on
  434.     applObj (and demo the bitEdit
  435.     on superman logo)
  436. 3. Change two scrollbar to one roam
  437.     box for the ITLib
  438.         move a libObj to far corner
  439.         Remove one scrollbar
  440.         Change the size of the other
  441.         Change its resize constraint
  442. 4. Move the roam box out of the Lib.
  443.     show the connection.
  444.  
  445. Window (Pane) in Window
  446. 1. Create root window and appl mode.
  447. 2. Add 2 window to it.
  448. 3. Add a DeskCal under the windows.
  449. 4. Add scroll bar.
  450. 5. Promote the whole application.
  451.  
  452. Create OddShape window
  453. 1. Use a FixedImage mode.
  454. 2. Form edit. (drill a rectangle hole in the shape).
  455. 3. Edit the figure. 
  456. 4. Use MoveImageController1.
  457.  
  458. Build Window
  459. 1. TitleBar move it to the bottom to make it wierd.
  460. 2. Resize box on topRight. Use fixedImage mode.  Fix the constraints.
  461. 3. Appl mode in the middle (use 'stickFourCorners').
  462. 4. Horizontal ScrollBar to the left.
  463. 5. Put a ordinary window in it.  Change ApplMode to 'matchViewportWindow'.
  464. 6. Promote it.
  465. *. Close box is a problem.  When closed, we lose the window.
  466. *. Show a window with vertical titlebar.
  467.  
  468. Two V ScrollBars for One
  469. 1. one vertical one horizontal
  470. 2. change one to vertical but longer
  471.  
  472. Build ScrollBar
  473. 1. My scrollbar
  474.     The link from roam box to marker needs special technique.  Occupy the target1 of roam box first, then try to link to marker.  System will ask a new inst var.
  475. 2. The Sml scrollbar
  476. "!
  477.  
  478. modeComposingTest
  479.     "Shan July 31, 1989"
  480.     "LibrarySpace modeComposingTest"
  481.  
  482.     | rMode w applCreator |
  483.     rMode _ RootMode new.
  484.     rMode label: 'MMS Mode Composer'.
  485.     rMode minimumSize: 900 @ 730.
  486.     w _ Window
  487.                 title: ' I T Library'
  488.                 origin: 450 @ 30
  489.                 extent: 400 @ 400.
  490.     w titleBar: ShadedTitleBar new.
  491.     w shrinkPosition: 700 @ 50.
  492.     w initialOpen.
  493.     w applicationMode: (LibrarySpace new mode insideColor: Form white).
  494.     w addVerticalScrollBar.
  495.     w addHorizontalScrollBar.
  496.     w attachModeTo: rMode.
  497.     applCreator _ ApplObjCreator new.
  498.     applCreator attachModeTo: rMode at: 750@450.
  499.     rMode startUp! !
  500.  
  501. !LibrarySpace class methodsFor: 'IT store access'!
  502.  
  503. ITStore
  504.     "Shan September 16, 1989"
  505.  
  506.     | libObj prototype m |
  507.     ITStore isNil
  508.         ifTrue: 
  509.             [ITStore _ Dictionary new.
  510.             prototype _ SemanticObject new.
  511.             prototype mode extent: 40 @ 40.
  512.             prototype mode insideColor: Form white.
  513.             prototype mode borderWidth: 1.
  514.             libObj _ LibraryObject prototype: prototype name: 'Vanilla Mode'.
  515.             libObj mode origin: 10 @ 10.
  516.             ITStore at: libObj name put: libObj.
  517.             prototype _ Window title: 'title' extent: 80 @ 60.
  518.             prototype shrinkPosition: 37 @ 53.
  519.             prototype initialOpen.
  520.             libObj _ LibraryObject prototype: prototype name: 'Plain Window'.
  521.             libObj mode origin: 10 @ 80.
  522.             ITStore at: libObj name put: libObj.
  523.             prototype _ TextLabel text: 'Text' borderWidth: 2.
  524.             prototype fixedSize: true.
  525.             prototype mode borderWidth: 2.
  526.             prototype mode insideColor: Form white.
  527.             prototype mode extent: 60 @ 30.
  528.             libObj _ LibraryObject prototype: prototype name: 'Fixed Size Label'.
  529.             libObj mode origin: 10 @ 180.
  530.             ITStore at: libObj name put: libObj.
  531.             prototype _ TextButton text: 'OK' borderWidth: 2.
  532.             prototype fixedSize: true.
  533.             prototype mode borderWidth: 2.
  534.             prototype mode insideColor: Form white.
  535.             prototype mode extent: 50 @ 30.
  536.             libObj _ LibraryObject prototype: prototype name: 'Text Button'.
  537.             libObj mode origin: 130 @ 10.
  538.             ITStore at: libObj name put: libObj.
  539.             "Shan September 5, 1989"
  540.             prototype _ SemanticObject new.
  541.             m _ FixedImageMode new.
  542.             m displayObject relAdd: MMSOpaqueForm oddShape.
  543.             m semanticObject: prototype.
  544.             libObj _ FixedImageLibObj prototype: prototype name: 'Iconic Mode'.
  545.             libObj mode origin: 130 @ 70.
  546.             ITStore at: libObj name put: libObj.
  547.             "Shan September 11, 1989"
  548.             prototype _ RoamBox new.
  549.             prototype mode extent: 80 @ 50.
  550.             libObj _ LibraryObject prototype: prototype name: 'Roam Box'.
  551.             libObj mode origin: 130 @ 180.
  552.             ITStore at: libObj name put: libObj].
  553.     ^ITStore! !
  554.  
  555. SemanticObject subclass: #ApplObjCreator
  556.     instanceVariableNames: ''
  557.     classVariableNames: 'ApplObjCreatorMiddleButtonMenu '
  558.     poolDictionaries: ''
  559.     category: 'ModeComposer-Shan'!
  560.  
  561.  
  562. !ApplObjCreator methodsFor: 'MMS-initializations'!
  563.  
  564. defaultMMSControllerClass
  565.     "Shan August 7, 1989"
  566.  
  567.     ^MidMenuAndMoveController!
  568.  
  569. setUpAppearance
  570.     "Shan August 6, 1989"
  571.  
  572.     mode extent: 100@60.
  573.     mode borderWidth: 4.
  574.     mode borderColor: Form darkGray.
  575.     mode insideColor: Form veryLightGray.
  576.     mode displayObject relAdd: ' Application\  Creator' withCRs asDisplayText.
  577.     mode highlightDispObj: #inverseHighlight! !
  578.  
  579. !ApplObjCreator methodsFor: 'private'!
  580.  
  581. placeApplDelegate: aDelegate 
  582.     "Shan August 7, 1989"
  583.  
  584.     | rootMode dMode newPos |
  585.     rootMode _ mode topMode.
  586.     aDelegate attachModeTo: rootMode absAt: mode displayBox bottomLeft + (5 @ 5).
  587.     dMode _ aDelegate mode.
  588.     dMode display.
  589.     self eventQueue cursorPoint: dMode displayBox center.
  590.     newPos _ dMode controller moveImageFB.
  591.     newPos notNil ifTrue: [dMode moveTo: newPos].
  592.     aDelegate mode display.
  593.     mode deHighlight! !
  594.  
  595. !ApplObjCreator methodsFor: 'middleMenu support'!
  596.  
  597. createDelegate
  598.     "Create a delegate object that can be manipulated on the screen for  
  599.      the application object.  Shan August 7, 1989"
  600.  
  601.     | className superClassName applDelegate |
  602.     self eventQueue disable.
  603.     "Ask for class name"
  604.     className _ FillInTheBlank request: 'Name of the application class?' initialAnswer: ''.
  605.     self eventQueue enable.
  606.     className = '' ifTrue: [^self].
  607.     "If new class, ask for super class"
  608.     (Cursor read showWhile: [Smalltalk classNames includes: className])
  609.         ifFalse: 
  610.             [self eventQueue disable.
  611.             superClassName _ FillInTheBlank request: 'New class?  Tell me the name of its superClass.' initialAnswer: 'Object'.
  612.             self eventQueue enable.
  613.             superClassName = '' ifTrue: [^self].
  614.             "Create the class"
  615.             Cursor wait showWhile: [(Smalltalk at: superClassName asSymbol)
  616.                     subclass: className asSymbol
  617.                     instanceVariableNames: ''
  618.                     classVariableNames: ''
  619.                     poolDictionaries: ''
  620.                     category: 'Temporary-User']].
  621.     "Put it onto the screen."
  622.     applDelegate _ ObjectDelegate clientObject: (Smalltalk at: className asSymbol) new.
  623.     self placeApplDelegate: applDelegate! !
  624.  
  625. !ApplObjCreator methodsFor: 'menu acces'!
  626.  
  627. middleButtonMenu
  628.     "Shan August 7, 1989"
  629.  
  630.     | logicMenu |
  631.     ApplObjCreatorMiddleButtonMenu isNil
  632.         ifTrue: 
  633.             [logicMenu _ MMSMenu new.
  634.             logicMenu append: (MenuCell selector: #createDelegate text: 'Create Delegate').
  635.             ApplObjCreatorMiddleButtonMenu _ MMSPopUpMenu createInterfaceFor: logicMenu].
  636.     ^ApplObjCreatorMiddleButtonMenu! !